;;(load "err-ut.scm")
;;(load "aux.scm")

(define tran-func-return #f)
(define tran-macro-travel-dat #f)
(define tran-travel-type-key-list '())
(define tran-sexp-backquote-call #f)
(define tran-rest-func-flag #f)
(define 编译期正在定义函数 #f)
(define 编译期正在定义函数名 #f)
(def/err (cyl->lisp l lang)
  (cond
   ((or (eq? lang 'scm)(eq? lang 'ss)) (string-append (cyl->scm/pre) (cyl->scm l)))
   ((or (eq? lang 'lisp)(eq? lang 'lsp)) (string-append (cyl->lsp/pre) (cyl->lsp l)))
   ((eq? lang 'el) (string-append (cyl->el/pre) (cyl->el l)))
   ((eq? lang 'rkt) (string-append (cyl->rkt/pre) (cyl->rkt l)))
   (else (list 'err 0 'cyl->lisp (format "未识别的语言类型。[~a]" lang)))))
(def/err (cyl->scm/pre)
 (let ((res-l '())
	)
   ;;(y-or-n "cyl->scm/pre:cyl-current-symbol-dict-list=~a\ncyl-local-symbol-backup-list=~a\n" cyl-current-symbol-dict-list cyl-local-symbol-backup-list)
   (set! cyl-macro-reg #f)
   (if (not (null? cyl-current-symbol-dict-list))
       (begin
	(tr-list (i e cyl-current-symbol-dict-list 0)
		 (let ((name (nth 0 e))
		       (typ (nth 1 e))
		       (val (var-val->sym-val e))
		       )
		   (if (eq? typ '全局变量)
		       (push (string-append "(define " name " " val ")\n")  res-l))))
	(merge-str 0 res-l) 
	)
    "")))
(def/err (cyl->scm l)
  (cond
   ((null? l)
    '())
   ((pair? l)
    (let ((a (nth 0 l))
	  (b (nth 1 l))
	  (c (nth 3 l))
	  )
      ;;(y-or-n "cyl->scm:a=~a,b=~a,c=~a.\n" a b c)
     
      (cond
       ((and (atom? a)(st-is c '不处理符号))
	'|not handle|)
       ((and (atom? a)(string? a))
	(run/err str->sym-val l))
       ((and (atom? a)(not (string? a)))
	(list 'err (nth 4 l) 'cyl->scm (format "开发错误，不允许出现非字符串首项[~a]。" l)))
       ((and (pair? a)(integer? b))
	(run/err list->syn-val l))
       ((and (pair? a)(null? b))
	(run/err cyl->scm a))
       ((and (pair? a)(pair? b))
	(let ((scm-l '()))
	(tr-list (i e l 0)
		 (let ((la (run/err cyl->scm e)))
		   (if (not (eq? la '|not handle|))
		       (push la scm-l))))
	(merge-str 0 scm-l)
	))
       (else (list 'err (nth 4 l) 'cyl->scm (format "开发错误，状态未处理。[~a][~a][~a]" a b c)))
       )))
   (else (list 'err (nth 4 l) 'cyl->scm (format "开发错误，不允许是原子数据。[~a]" l)))))
(def/err (str->sym-val l)
  (let ((name (nth 0 l))
	(len (nth 1 l))
	(coding (nth 2 l))
	(typ (nth 3 l))
	(ser (nth 4 l))
	(fn (nth 5 l))
	(par-num (nth 6 l))
	)
    (cond
     ((st-is typ '常量)
      (cond
       ((or (eq? typ '整数)(eq? typ '小数)(eq? typ '指数数)(eq? typ '分数))
	name)
       ((eq? typ '二进制常数)
	name)
       ((eq? typ '八进制常数)
	name)
       ((eq? typ '十六进制常数)
	name)
       ((eq? typ '十进制常数)
	(if (char=? (string-ref name 1) #\d)
	    (substring name 2 (string-length name))
	    (substring name 1 (string-length name))))
       ((eq? typ '字符常量)
	(cond
	 ((string=? name "#\\空格") (set! name "#\\space"))
	 ((string=? name "#\\回车") (set! name "#\\newline"))
	 ((string=? name "#\\制表符") (set! name "#\\tab")))
	name)
       ((eq? typ '字符串)
	name)
       ((eq? typ '符号常量)
	name)
       ((eq? typ '字符串常量)
	(substring name 1 (string-length name)))
       ((eq? typ '扩展常量)
	(if (char=? (string-ref name 1) #\')
	    (substring name 1 (string-length name))
	    (string-append "'" (substring name 1 (string-length name)))))
       ((eq? typ '系统值常量)
	(cond
	 ((and (string? name)(string=? name "#%系统缺省值")) "#f")
	 ((and (string? name)(string=? name "#%无穷大")) "'无穷大")
	 ((and (string? name)(string=? name "#%无穷小")) "'无穷小")
	 (else (list 'err ser 'str->sym-val (format "[~a]不是合法的可转换常量值类型。" typ)))
	 ))
       ((eq? typ '系统变量常数)
	(let ((s-var (substring name 2 (string-length name))))
	  (let ((p (open-input-string s-var)))
	    (format "~a" (eval (read p))))))
       ((eq? typ '系统常量)
	name)
       ((eq? typ '列表常量)
	;;not defined
	(list 'err ser 'str->sym-val (format "[~a]尚未定义的常量类型。" typ))
	)
       (else (list 'err ser 'str->sym-val (format "[~a]不是合法的可转换常量类型。" typ))))
      )
     ((eq? typ '结束分隔符)
      "\n")
     ((eq? typ '函数定义分隔符)
      "\n\t")
     ((or (eq? typ '分隔符)(eq? typ '语句终结分隔符))
      (deli->eng-deli name))
     ((and (eq? typ '参数变量) cyl-tran-macro-func)
      (string-append "," name))
     ((and cyl-macro-reg (st-is typ '注册符号))
      (string-append "\"" name "\""))
     ((eq? typ '符号)
      name)
     ((st-is typ '变量)
      name)

     ((st-is typ '无参函数)
      (cond
       ((string=? name "函数返回")
	(set! tran-func-return #t)
	(string-append "(exit-" (fn->scm-fn cyl-current-define-functione-name) ")")
	)
       
       (else
	(string-append "(" name ")"))))
     ((or (eq? typ 'lisp系统函数)(eq? typ 'lisp函数))
      name)
     ((or (eq? typ '系统宏)(eq? typ '系统关键字))
      name)
     ;;add new type handle part here
     (else (list 'err ser 'str->sym-val (format "[~a]不是预期的原子类型。" typ)))
     )))
(def/err (list->syn-val l)
  (let ((item (nth 0 l))
	(len (nth 1 l))
	(coding (nth 2 l))
	(typ (nth 3 l))
	(ser (nth 4 l))
	(fn (nth 5 l))
	(par-num (nth 6 l))
	)
    ;;(y-or-n "list->syn-call:item=~a,typ=~a.\n" item typ)
    (cond
     ((eq? typ 'y表达式调用)
      (yexp-call item))
     ((or (eq? typ '无限参数函数调用)(eq? typ '无限参数y表达式函数调用))
      (rest-yexp-call fn item))
     ((eq? typ 'lisp-call) ;;s表达式调用)
      (sexp-call item))
     ((eq? typ '系统关键字调用)
      (sys-key-call item))
     ((eq? typ '系统宏调用)
      (sys-macro-call item))
     ((eq? typ '函数定义)
      (func-define-proc item))
     ((eq? typ '函数体定义)
      (func-define-body item))
     ((eq? typ '并列语句)
      (begin-call item))
     ((st-is typ '函数名定义)
      (func-define-name item))
     ((eq? typ '无参函数隐参调用)
      (no-par-func-call item))
     ((st-is typ '不处理符号)
      )
     (else (list 'err ser 'list->syn-val (format "[~a]不是合法的列表类型。" typ))))))
(def/err (no-par-func-call l)
  (let ((func-l (nth 0 l))
	(assign-l (nth 1 l))
	(res-l '())
	)
    (push "(fluid-let (" res-l)
    (if (eq? (nth 3 assign-l) '隐参赋值列表)
	(begin
	  (push (hide-par-handle (nth 0 assign-l)) res-l)
	  (push ") " res-l)
	  (if (eq? (nth 3 func-l) '无参函数调用)
	      (begin
		(push (nth 0 func-l) res-l)
		(push ")" res-l)
		(merge-str 0 res-l))
	      (list 'err (nth 4 func-l) 'no-par-func-call (format "无参函数非法。[~a]" func-l)))
	  )
	(list 'err (nth 4 assign-l) 'no-par-func-call (format "隐参列表非法。[~a]" assign-l))
	)))
(def/err (hide-par-handle l)
  (let ((res-l '())
	)
    (tr-list (i e l 0)
	     (let ((typ (nth 3 e))
		   )
	       (cond
		((eq? typ '参数赋值开始)
		 )
		((eq? typ '参数赋值结束)
		 )
		((eq? typ '隐参赋值)
		 (push (get-assign-pair (nth 0 e)) res-l))
		(else
		 (exit-hide-par-handle (list 'err (nth 4 e) 'hide-par-handle (format "未定义类型。[~a]" typ))))
		)))
    (merge-str-blank (reverse res-l))))
(def/err (get-assign-pair l)
  (let ((res-l '())
	)
    (push "(" res-l)
    (tr-list (i e l 0)
	     ;;(y-or-n "e=~a,i=~a\n" e i)
	     (let ((typ (nth 3 e))
		   )
	      
	       (cond
		((and (= i 0)(st-is typ '隐参变量))
		 (push (nth 0 e) res-l))
		((and (= i 1)(eq? typ '分隔符))
		 (push " " res-l)
		 )
		((= i 2)
		 (push (cyl->scm e) res-l))
		((or (eq? typ '分隔符)(eq? typ '函数定义分隔符))
		 )
		(else
		 (exit-get-assign-pair (list 'err (nth 4 e) 'get-assign-pair (format "位置不匹配或者异常类型。[~a:~a]" i typ)))
		 ))
	      
	       ))
    (push ")" res-l)
    (merge-str 0 res-l)
    ))
(def/err (yexp-call l)
  (let ((fn "")
	(fn-l '())
	(par-l '())
	(res-s "")
	(typ #f)
       	(scm-sign "【*】")
	)
    (tr-list (i e l 0)
	     (set! name (nth 0 e))
	     (set! typ (nth 3 e))
	     (cond
	      ((eq? typ '函数名片段)
	       (push name fn-l))
	      (else
	       (push scm-sign fn-l)
	       (let ((la (run/err cyl->scm e)))
		 (if (not (eq? la '|not handle|))
		     (push la par-l))))
	     ;;(y-or-n "yexp-call:fn-l=~a,par-l=~a.\n" fn-l par-l)
	      ))
    (set! fn (merge-str 0 fn-l))
    (cond
     ((string=? fn "函数返回【*】")
      (set! res-s (string-append "(exit-" (fn->scm-fn cyl-current-define-function-name) " " (merge-str-blank par-l) ")"))
      (set! tran-func-return #t))
     ((string=? fn "循环退出【*】")
      (set! res-s (string-append "(循环退出 " (merge-str-blank par-l) ")")))
     (else
      (set! res-s (string-append "(" fn " " (merge-str-blank (reverse par-l)) ")"))))
    res-s))
(define (fn->scm-fn fn)
  (let ((fn-l '()))
    (tr-string (i c fn 0)
	       (cond
		((char=? c #\[)
		 (push #\【 fn-l))
		((char=? c #\])
		 (push #\】 fn-l))
		(else (push c fn-l))
		))
    (list->string (reverse fn-l))))
(define (deli->eng-deli fn)
  (let ((fn-l '()))
    (tr-string (i c fn 0)
	       (cond
		((char=? c #\。)
		 )
		((char=? c #\，)
		 )
		((char=? c #\；)
		 )
		((char=? c #\：)
		 )
		(else (push c fn-l))
		))
    (list->string (reverse fn-l))))
(def/err (rest-yexp-call f l)
  ;;无限参数调用必须可扩展参数在最后位置。
  (let ((fn "")
	(fn-l '())
	(par-l '())
	(res-s "")
	(typ #f)
	(scm-sign "【*】")
	)
    (tr-list (i e l 0)
	     (set! name (nth 0 e))
	     (set! typ (nth 3 e))
	     (cond
	      ((eq? typ '函数名片段)
	       (push name fn-l))
	      (else
	       (push scm-sign fn-l)
	       (let ((la (run/err cyl->scm e)))
		 (if (not (eq? la '|not handle|))
		     (push la par-l))))
	     ;;(y-or-n "yexp-call:fn-l=~a,par-l=~a.\n" fn-l par-l)
	      ))
    (if (string=? f "[*]、...")
	(set! res-s (string-append "(" (merge-str-blank (reverse par-l)) ")"))
	(set! res-s (string-append "(" (fn->scm-fn f) " " (merge-str-blank (reverse par-l)) ")")))
    res-s))
(def/err (sexp-call l)
  (let ((sexp-1-typ (nth 3 (nth 0 l)))
	(sexp-l '())
	(n 0)
	(tmp-flag #f)
	(ss "")
	)
    ;;(y-or-n "sexp-call:l=~a,sexp-1-typ=~a.\n" l sexp-1-typ)
    (if (eq? sexp-1-typ 'lisp-begin)
	(set! n 0)
	(begin
	  (if (eq? sexp-1-typ 'lisp-backquote)
	      (begin
		(set! tmp-flag tran-sexp-backquote-call)
		(set! tran-sexp-backquote-call #t)
		))
	  (set! n 1)))
    (tr-list (i e l n)
	     (set! name (nth 0 e))
	     (set! typ (nth 3 e))
	     (cond
	      ((eq? typ 'lisp-call)
	       (push (sexp-call (car e)) sexp-l))
	      ((or (eq? typ 'lisp-begin)(eq? typ 'lisp-end)(eq? typ '分隔符))
	       )
	      (else
	       (let ((la (run/err cyl->scm e)))
		 (if (not (eq? la '|not handle|))
		     (push la sexp-l))))
	     ;;(y-or-n "sexp-call:sexp-l=~a.\n" sexp-l)
	      ))
    ;;(y-or-n "sexp-call:sexp-l=~S,flag=~a,typ=~a\n" sexp-l tran-sexp-backquote-call sexp-1-typ)
      (cond
       ((eq? sexp-1-typ 'lisp-begin)
	(string-append "(" (merge-str-blank (reverse sexp-l)) ")"))
       ((eq? sexp-1-typ 'lisp-quote)
	(cond
	 ((= (length sexp-l) 1)
	  (string-append "'" (car sexp-l)))
	 ((= (length sexp-l) 2)
	  (string-append "'" (merge-str-blank (reverse sexp-l)) ))
	 (else
	  (list 'err (nth 4 (nth 0 l)) 'sexp-call (format "不允许[']后无符号。")))))
       ((and tran-sexp-backquote-call (eq? sexp-1-typ 'lisp-unquote))
	(cond
	 ((= (length sexp-l) 1)
	  (string-append "," (car sexp-l)))
	 ((> (length sexp-l) 1)
	  (string-append "," (merge-str-blank (reverse  sexp-l))))
	 (else
	  (list 'err (nth 4 (nth 0 l)) 'sexp-call (format "不允许[,]后无符号。")))))
       ((eq? sexp-1-typ 'lisp-unquote)
	(cond
	 ((= (length sexp-l) 1)
	  (set! ss (car sexp-l))
	  (if (char=? (string-ref ss 0) #\()
	      (string-append "(list " (substring ss 1 (string-length ss)))
	      (string-append "(list " ss ")")))
	 ((> (length sexp-l) 1)
	  (set! ss (merge-str-blank (reverse sexp-l)))
	  (string-append "(list " (substring ss 1 (string-length ss)) ))
	 (else
	  (list 'err (nth 4 (nth 0 l)) 'sexp-call (format "不允许[,]后无符号。")))))
       ((eq? sexp-1-typ 'lisp-backquote)
	(cond
	 ((= (length sexp-l) 1)
	  (set! tran-sexp-backquote-call tmp-flag)
	  (string-append "`" (car sexp-l)))
	 ((> (length sexp-l) 1)
	  (set! tran-sexp-backquote-call tmp-flag)
	  (string-append "`" (merge-str-blank (reverse sexp-l))))
	 (else
	  (list 'err (nth 4 (nth 0 l)) 'sexp-call (format "不允许[`]后无s表达式。")))))
       (else
	(list 'err (nth 4 (nth 0 1)) 'sexp-call (format "lisp-call类型cyl首原子符号只允许[`,'(]，不允许是[~a] 。" sexp-1-typ))))))
(def/err (begin-call l)
  (let ((proc-l (list "并列语句"))
	)
    (tr-list (i e l 0)
	     (let ((la (run/err cyl->scm e)))
	       (if (not (eq? la '|not handle|))
		   (push la proc-l))))
    (string-append "(" (merge-str-blank (reverse proc-l)))))
(def/err (sys-key-call l)
  (let ((res-l '())
	)
    (tr-list (i e l 0)
	     (let ((name (nth 0 e))
		   (typ (nth 3 e))
		   (coding (nth 2 e))
		   (place-holder-list '((sys 113)))   ;;'((sys 113)(sys 116)(sys 117)(sys 118)(sys 121)))
		   (place-holder-key-flag #f)
		   )
	       (cond
		((eq? typ '系统关键字)
		 (if (member name tran-travel-type-key-list)
		     (set! tran-macro-travel-dat #f))
		 (if (member coding place-holder-list)
		     (set! place-holder-key-flag #t)
		     (push name res-l)))
		((st-is typ '不处理符号)
		 )
		(else
		 (let ((la (run/err cyl->scm e)))
		   (if (not (eq? la '|not handle|))
		       (push la res-l))))
		)))
    (string-append "(" (merge-str-blank (reverse res-l)) ")")))
(def/err (sys-macro-call l)
  (let ((res-l '())
	;;(macro-travel #f)
	(dat-list '())
	)
    (tr-list (i e l 0)
	     (let ((name (nth 0 e))
		   (typ (nth 3 e))
		   )
	       (cond
		((eq? typ '系统宏)
		 (cond
		  ((string=? name "注册")
		   (set! cyl-macro-reg #t))
		  ((string=? name "遍历")
		   (set! tran-travel-type-key-list (nth 1 (nth 5 (search-dict-member name cyl-system-symbol-dict-list))))
		   ;;(y-or-n "travel-type-key-list=~a\n" tran-travel-type-key-list)
		   (set! tran-macro-travel-dat #t))
		  )
		 (push name res-l))
		((st-is typ '不处理符号)
		 )
		(else
		 (let ((la (run/err cyl->scm e)))
		   (cond
		    (tran-macro-travel-dat
		     ;;(y-or-n "macro1:flag=~a,dat=~a,la=~a\n" tran-macro-travel-dat dat-list la)
		     (set! dat-list (append dat-list (list la)))
		     )
		    
		    ((not (eq? la '|not handle|))
		     ;;(y-or-n "macro2:flag=~a,dat=~a,la=~a\n" tran-macro-travel-dat dat-list la)
		     (if (and (not tran-macro-travel-dat)(not (null? dat-list)))
			 (begin
			   (push (string-append "(" (merge-str-blank dat-list) ")") res-l)
			   (set! dat-list '())
			   (push la res-l))
			 (push la res-l)))
		     )
		    ))
		)
	       
	       ))
    (set! cyl-macro-reg #f)
    (string-append "(" (merge-str-blank (reverse res-l)) ")")))
(def/err (func-define-proc l)
  (let ((res-l '())
	(name-l '())
	)
    ;;(y-or-n "func-define-proc:l=~a\n" l)
    (tr-list (i e l 0)
	     (let ((name (nth 0 e))
		   (typ (nth 3 e))
		   )
	       ;;(y-or-n "func-define-proc0:name=~a,typ=~a\n" name typ)
	       (cond
		((st-is typ '函数名定义)
		 (set! name-l (run/err func-define-name e)))
		((eq? typ '函数体定义)
		 (push (run/err func-define-body (nth 0 e)) res-l))
		(else
		 (let ((la (run/err cyl->scm e)))
		   (if (not (eq? la '|not handle|))
		       (push la res-l))))
		)))
    (if tran-func-return
	(let* ((n-l (reverse name-l))
	       (func-def-typ (nth 0 n-l))
	       )
	  (cond
	   ((string=? func-def-typ "define")
	    (set! name-l (append (list "def/ret") (list-tail n-l 1))))
	   ((string=? func-def-typ "define-macro")
	    (set! name-l (append (list "define-macro/ret") (list-tail n-l 1))))
	   (else (set! name-l n-l))))
	(set! name-l (reverse name-l)))
    
    (set! tran-func-return #f)
    (set! cyl-tran-macro-func #f)
    (set! cyl-current-define-function-name #f)
    (set! 编译期正在定义函数名 #f)
    (set! 编译期正在定义函数 #f)
    (string-append "(" (merge-str-blank name-l) (merge-str-blank (reverse res-l)) ")\n")))

(def/err (func-define-name l)
  (let ((item (nth 0 l))
	(typ (nth 3 l))
	(fn (if (null? (nth 5 l)) (nth 0 l) (nth 5 l)))
	)
    (set! 编译期正在定义函数名 (fn->scm-fn (string-append "'" fn)))
    (set! 编译期正在定义函数 (fn->scm-fn fn))
    ;;(y-or-n "func-define-name:item=~a,typ=~a,fn=~a\n" item typ fn)
      (cond
       ((eq? typ 'y表达式函数名定义)
	(set! cyl-current-define-function-name fn)
	(func-name-yexp item fn))
       ((eq? typ '无限参数函数名定义)
	(set! cyl-current-define-function-name fn)
	(rest-func-name-yexp item fn))
       ((eq? typ '无参函数名定义)
	(set! cyl-current-define-function-name item)
	(func-name-ciyu item))
       ((eq? typ 'at表达式函数名定义)
	(set! cyl-current-define-function-name fn)
	(func-name-yexp item fn))
       ((eq? typ 'at表达式无参函数名定义)
	(set! cyl-current-define-function-name item)
	(func-name-ciyu item))
       (else
	(list 'err (nth 4 l) 'func-define-name (format "[~a]函数名定义类型未定义处理方式，开发错误。" typ))))))
(def/err (func-name-yexp l fn)
  (let ((res-l '())
	(cur-rec  (get-func-name-define-record fn))
	)
    ;;(y-or-n "func-name-yexp:l=~a,fn=~a,cur-rec=~a\n" l fn cur-rec)
    
    (if cur-rec
	(let ((cur-typ (nth 1 cur-rec))
	      (at-define-list (nth 6 cur-rec))
	      )
	  
	  (cond
	   ((eq? cur-typ '局部函数)
	    (set! cyl-tran-macro-func #t)
	    (cond
	     ((search-at-define-list "#%错误处理" at-define-list)
	      (push "define-macro/err" res-l))
	    
	     (else (push "define-macro" res-l)))
	    (push (yexp-call l) res-l)
	    ;;(merge-str-blank (reverse res-l))
	    )
	   ((eq? cur-typ '函数)
	    (cond
	     ((search-at-define-list "#%错误处理" at-define-list)
	      (push "def/err" res-l))
	    
	     (else (push "define" res-l)))
	    (push (yexp-call l) res-l)
	    ;;(merge-str-blank (reverse res-l))
	    )
	   (else
	    (list 'err (nth 4 (nth 0 l)) 'func-name-yexp (format "[~a]函数类型未定义，开发错误。" cur-typ)))))
	(list 'err (nth 4 (nth 0 l)) 'func-name-yexp (format "[~a]函数在定义词典中未找到，开发错误。" fn)))))
(def/err (rest-yexp-par-call l fn)
   (let ((par-l '())
	(res "")
	)
    (tr-list (i e l 0)
	     (set! name (nth 0 e))
	     (set! typ (nth 3 e))
	     (cond
	      ((eq? typ '函数名片段)
	       )
	      (else
	       ;;(push scm-sign fn-l)
	       (let ((la (run/err cyl->scm e)))
		 (if (not (eq? la '|not handle|))
		     (push la par-l))))
	     ;;(y-or-n "yexp-call:fn-l=~a,par-l=~a.\n" fn-l par-l)
	      ))
    (set! res (pop par-l))
    (push "." par-l)
    (push res par-l)
    (string-append "(" (fn->scm-fn fn) " " (merge-str-blank (reverse par-l)) ")")))
  
(def/err (rest-func-name-yexp l fn)
  (let ((res-l '())
	(cur-rec  (get-func-name-define-record fn))
	)
    ;;(y-or-n "func-name-yexp:l=~a,fn=~a,cur-rec=~a\n" l fn cur-rec)
    
    (if cur-rec
	(let ((cur-typ (nth 1 cur-rec))
	      )
	  
	  (cond
	   ((eq? cur-typ '函数)
	    (push "define" res-l)
	    (push (rest-yexp-par-call l fn) res-l)
	    ;;(y-or-n "res-l=~a\n" res-l)
	    ;;res-l
	    )
	   (else
	    (list 'err (nth 4 (nth 0 l)) 'func-name-yexp (format "[~a]函数类型未定义，无限参数函数只允许'函数类型，其他类型为开发错误。" cur-typ)))))
	(list 'err (nth 4 (nth 0 l)) 'func-name-yexp (format "[~a]函数在定义词典中未找到，开发错误。" fn)))))
(def/err (func-name-ciyu l)
  (let ((res-l '())
	(cur-rec (get-func-name-define-record l))
	(fn l)
	)
   ;;(y-or-n "func-name-ciyu:l=~a,rec=~a\n" l cur-rec)
    (if cur-rec
	(let ((cur-typ (nth 1 cur-rec))
	      (at-define-list (nth 6 cur-rec))
	      )
	  (cond
	   ((eq? cur-typ '无参局部函数)
	    (set! cyl-tran-macro-func #t)
	    (cond
	     ((search-at-define-list "#%错误处理" at-define-list)
	      (push "define-macro/err" res-l))
	     (tran-func-return
	      (push "define-macro/ret" res-l))
	     (else (push "define-macro" res-l)))
	    (push (string-append "(" fn ")") res-l)
	    ;;(merge-str-blank (reverse res-l))
	    )
	   ((eq? cur-typ '无参函数)
	    (cond
	     ((search-at-define-list "#%错误处理" at-define-list)
	      (push "def/err" res-l))
	     (tran-func-return
	      (push "def/ret" res-l))
	     (else (push "define" res-l)))
	    (push (string-append "(" fn ")") res-l)
	    ;;(merge-str-blank (reverse res-l))
	    )
	   (else
	    (list 'err (nth 4 (nth 0 l)) 'func-name-ciyu (format "[~a]函数类型未定义，开发错误。" cur-typ)))))
	(list 'err (nth 4 (nth 0 l)) 'func-name-ciyu (format "[~a]函数在定义词典中未找到，开发错误。" fn)))))

(def/err (func-define-body l)
  (let ((res-l '())
	)
    ;;(y-or-n "func-define-body:l=~a\n" l)
    (if cyl-current-define-function-name
	(let ((dict-rec (search-dict-member cyl-current-define-function-name cyl-local-symbol-backup-list))
	      )
	  (if dict-rec
	      (let ((dict-l (nth 1 dict-rec))
		    (let-var 0)
		    )
		(if cyl-tran-macro-func (push "`(let" res-l) (push "(let" res-l))
		(push "(" res-l)
		(tr-list (i e dict-l 0)
			 (let ((name (nth 0 e))
			       (typ (nth 1 e))
			       (val (var-val->sym-val e))
			       )
			   (if (eq? typ '局部变量)
			       (begin
				 (set! let-var (+ let-var 1))
				 (push (string-append "(" name " " val ")")  res-l)))))
		(if (> let-var 0)
		    (begin
		      (push ")" res-l)
		      (push (run/err cyl->scm l) res-l)
		      (push ")" res-l)
		      (merge-str-blank (reverse res-l))
		      )
		    (begin
		      (pop res-l)
		      (pop res-l)
		      (if cyl-tran-macro-func (push "`(begin" res-l))
		      (push (run/err cyl->scm l) res-l)
		      (if cyl-tran-macro-func (push ")" res-l))
		      (merge-str-blank (reverse res-l))
		      ))
		)
	      (list 'err (nth 4 (nth 0 l)) 'func-define-body (format "[~a]在本地函数定义字典中不存在，开发错误。" cyl-current-define-function-name))))
	(list 'err (nth 4 (nth 0 l)) 'func-define-body (format "cyl-current-define-function-name未定义为合理函数名，开发错误。")))))

(def/err (var-val->sym-val l)
  (let ((var-name (nth 0 l))
	(var-typ (nth 1 l))
	(coding (nth 2 l))
	(typ (nth 5 l))
	(name (nth 6 l))
	)
    (cond
     ((null? typ)
      "'()")
     ((st-is typ '常量)
      (cond
       ((or (eq? typ '整数)(eq? typ '小数)(eq? typ '指数数)(eq? typ '分数))
	name)
       ((eq? typ '二进制常数)
	name)
       ((eq? typ '八进制常数)
	name)
       ((eq? typ '十六进制常数)
	name)
       ((eq? typ '十进制常数)
	(if (char=? (string-ref name 1) #\d)
	    (substring name 2 (string-length name))
	    (substring name 1 (string-length name))))
       ((eq? typ '字符常量)
	(cond
	 ((string=? name "#\\空格") (set! name "#\\space"))
	 ((string=? name "#\\回车") (set! name "#\\newline"))
	 ((string=? name "#\\制表符") (set! name "#\\tab")))
	name)
       ((eq? typ '字符串)
	name)
       ((eq? typ '字符串常量)
	(substring name 1 (string-length name)))
       ((eq? typ '扩展常量)
	(string-append "'" (substring name 1 (string-length name))))
       ((eq? typ '列表常量)
	;;not defined
	(list 'err ser 'str->sym-val (format "[~a]尚未定义的常量类型。" typ))
	)
       ((eq? typ '系统值常量)
	(cond
	 ((and (string? name)(string=? name "#%系统缺省值")) "#f")
	 ((and (string? name)(string=? name "#%无穷大")) "'无穷大")
	 ((and (string? name)(string=? name "#%无穷小")) "'无穷小")
	 (else "'()")))
       (else
	"'()"))
      )
      ;;add new type handle part here
     (else "'()")
     )))		
		
	      
	
			 
    
	
	    
     
    
   

	     
  


		       
	   
  


  
   
	      

	
